home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / boostrs.arc / BODEMO.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1985-11-19  |  30.5 KB  |  962 lines
  1. Const
  2.    H  = 'H';                  { Code for horizontal PutStr & GetStr }
  3.    V  = 'V';                  { "    "   vertical   "      " "      }
  4.    StartElapsed : Boolean = FALSE;
  5.                               { Initial value for Timer function    }
  6.    Npage = 4;                 { Number of heap pages                }
  7.  
  8. Var
  9.    J                 : Integer;
  10.    Att1, Att2        : Byte;
  11.  
  12.    MidPoint, H_Off   : Integer;
  13.  
  14.    StartCol, StartRow,
  15.    NumCols,  NumRows,
  16.    Xinc              : Integer;
  17.  
  18. { ---------------------------------------
  19.   BODECL declarations below, with PAGE[5]
  20.   --------------------------------------- }
  21.  
  22. Type
  23.    AnyString   =  string[255];
  24.    HeapBuf     =  ^AnyBuf;
  25.    AnyBuf      =  record
  26.                      Screen : array[1..4000] of byte;
  27.                   end;
  28.    ColumnType  =  0..80;
  29.    RowType     =  0..25;
  30.    result      =  Record
  31.                      AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : Integer;
  32.                   end;
  33.  
  34. Var
  35.  
  36.    TimeElapsed,               { Used by Timer . . . }
  37.    SaveElapsed,               { "    "  "           }
  38.    PageSegment,               { Segment address of page }
  39.    PageOffSet,                { Offset address of page }
  40.    Ecode,                     { "    "  Exec for error return }
  41.    I                          { the ubiquitous index variable  }
  42.                      : Integer;
  43.    SaveX                      { handy for saving WhereX result }
  44.                      : ColumnType;
  45.    SaveY                      { "     "   "      WhereY "      }
  46.                      : RowType;
  47.    Xheap             : ColumnType;
  48.    Yheap             : RowType;
  49.  
  50.    HeapTop                    { Current top of heap }
  51.                      : ^Integer;
  52.  
  53.    Ch                         { as in read(Kbd,ch) after KeyPressed }
  54.                      : Char;
  55.  
  56.    Page                       { screens for SaveScreen, RestoreScreen,
  57.                                 and MoveBg }
  58.                      : array[1..Npage] of HeapBuf;
  59.  
  60.    VideoStatus       : byte   absolute $0000:$0449;
  61.    MonoBuffer        : AnyBuf absolute $B000:0000;
  62.    GraphicsBuffer    : AnyBuf absolute $B800:0000;
  63.    Regs              : Result;
  64.  
  65.    S,                         { general string array }
  66.    FileDesc,                  { File name and extension for EXEC }
  67.    ComLine                    { Command Line setting for EXEC    }
  68.                      : AnyString;
  69.  
  70. const
  71.    logo : array[1..6] of AnyString =
  72.  
  73.           ( '▒▒▒▒▒ ▒▒▒▒ ▒▒▒▒ ▒▒▒▒ ▒▒▒▒▒ ▒▒▒▒ ▒▒▒▒ ▒▒▒▒',
  74.             '▒   ▒ ▒  ▒ ▒  ▒ ▒      ▒   ▒    ▒  ▒ ▒   ',
  75.             '▒▒▒▒▒ ▒  ▒ ▒  ▒ ▒▒▒▒   ▒   ▒▒▒  ▒▒▒  ▒▒▒▒',
  76.             '▒   ▒ ▒  ▒ ▒  ▒    ▒   ▒   ▒    ▒ ▒▒    ▒',
  77.             '▒▒▒▒▒ ▒▒▒▒ ▒▒▒▒ ▒▒▒▒   ▒   ▒▒▒▒ ▒  ▒ ▒▒▒▒',
  78.             '                                        ');
  79.  
  80.    {$IBoosters}
  81.  
  82.  
  83. { --------------------------------------
  84.   SELECT simulates selection from a menu
  85.   -------------------------------------- }
  86. Procedure Select;
  87.  
  88. var
  89.    Num : Integer;
  90.  
  91. begin
  92.  
  93.    FstrHeap ( page[4], 'Qui', Xheap, Yheap );
  94.    SetAtt  ( Xheap-1, Yheap, Xheap+24, Yheap, 112);
  95.    SaveX := Xheap-1;
  96.    SaveY := Yheap;
  97.    wait(2);
  98.  
  99.           { Simulate UP arrow key press }
  100.    for num := 1  to 3 do
  101.    begin
  102.  
  103.       SetAtt ( SaveX, SaveY, SaveX+25, SaveY, 14);
  104.  
  105.       if SaveY = 10 then
  106.          SaveY := 16
  107.       else
  108.          SaveY := SaveY - 2;
  109.  
  110.       SetAtt ( SaveX, SaveY, SaveX+25, SaveY, 112);
  111.  
  112.       Wait(2);
  113.    end;
  114.  
  115. end { Select };
  116.  
  117. { ------------------------
  118.   MENU creates a demo menu
  119.   ------------------------ }
  120. Procedure Menu;
  121. begin
  122.  
  123.    FillHeap ( page[4],  1, 1, 80, 25, ' ', 0 );
  124.    BoxHeap  ( page[4], 20, 4, 60, 18, 2, 14);
  125.    PutHeap  ( page[4], h,#181+' Atlanta Division '+#198, 30, 4, 14);
  126.    HeapAt   ( page[4], 32, 4, 47, 4, 12 );
  127.  
  128.    PutHeap ( page[4], h, Center ( 'A BUDGET PREPARATION SYSTEM',39,' '),
  129.            21, 6, 14 );
  130.    PutHeap ( page[4], h, #199+Copies ( #196, 39 )+#182, 20, 8, 14);
  131.    PutHeap ( page[4], h, Center ( 'Resource  Budget Updates',39,' '),21,10,14);
  132.    PutHeap ( page[4], h, Center ( 'Equipment Budget Updates',39,' '),21,12,14);
  133.    PutHeap ( page[4], h, Center ( 'Reports                 ',39,' '),21,14,14);
  134.    PutHeap ( page[4], h, Center ( 'Quit                    ',39,' '),21,16,14);
  135.  
  136.    PutHeap ( page[4], h, Center ( #24+' Cursor Up   '+#25+' Cursor Down   '+
  137.            #17+#196+'  Enter to select',80,' '),1,25,14);
  138.    FstrHeap ( page[4], #17, Xheap, Yheap );
  139.    PutHeap  ( page[4], h, #217, Xheap+2, Yheap, 14 );
  140.    FstrHeap ( page[4], #24, Xheap, Yheap );
  141.    HeapAt   ( page[4], Xheap-1, Yheap, Xheap+49, Yheap, 30 );
  142.    BoxHeap ( page[4], 20, 20, 60, 22, 1, 14);
  143.    PutHeap ( page[4], h, Center ('Please Make A Selection',38,' '),21,21,14);
  144.    RestoreScreen ( page[4] );
  145.  
  146.    Select;
  147.  
  148.    If (SaveY = 10) or (SaveY = 12) then
  149.    begin
  150.       PutStr ( h, Center ('Enter Authorization Code',38,' '),21,21,112);
  151.       wait(2);
  152.    end;
  153.  
  154. end { Menu };
  155.  
  156. { ORDERing Boosters }
  157. Procedure Order;
  158. var
  159.    Buffer : integer;
  160. const
  161.    order : array[1..15] of AnyString =
  162.           ('POSTSCRIPT',
  163.            '    You are encouraged to use and share these ',
  164.            '    utilities.  If you find that they are helpful,',
  165.            '    a $25 contribution would be appreciated.',
  166.            '    ',
  167.            '    If you prefer, you may become a registered',
  168.            '    user for $35 and receive a printed copy of the',
  169.            '    users guide, update notices, and the latest ',
  170.            '    version of Boosters.',
  171.            '    ',
  172.            '    Please send check or money order to:',
  173.            'George F. Smith',
  174.            '609 Candlewick Lane',
  175.            'Lilburn, GA 30247',
  176.            '(404) 923-6879');
  177.  
  178. begin
  179.  
  180.    FillHeap ( page[1], 1,1,80,25,' ',14 );
  181.    BoxHeap  ( page[1], 9,3,71,23,1,14 );
  182.    PutHeap  ( page[1],h, Center ( Order[1],60 ,' '), 10, 5, 14 );
  183.    for i := 1 to 10 do
  184.       PutHeap ( page[1],h, Order[i+1], 11, 6+i, 14 );
  185.    for i := 1 to 4 do
  186.       PutHeap ( page[1],h, Center ( Order[11+i],60 ,' '), 10, 17+i, 14 );
  187.  
  188.    {             Nice, terse code that unfortunately makes snow - sigh.
  189.                  Other than that, it works beautifully.
  190.    PageSegment := Seg( Page[1]^ );
  191.    PageOffset  := Ofs( Page[1]^ );
  192.  
  193.    if VideoStatus = 7 then
  194.       Buffer := $B000
  195.    else
  196.       Buffer := $B800;
  197.  
  198.    for i := 1 to 25 do
  199.    begin
  200.       move ( mem[ PageSegment:PageOffset ],
  201.              mem[ Buffer:4000-(i*160) ], i*160 );
  202.       delay(30);
  203.    end;
  204.    }
  205.  
  206.    ClrScr;
  207.    for i := 1 to 25 do
  208.    begin
  209.       GetHeap ( Page[1], h, S, 1, i, 80 );
  210.       PutStr  ( h, S, 1, 25, 14 );
  211.       if i < 25 then
  212.          writeln;
  213.    end;
  214.    SetAtt  ( 1,1,80,25,30 );
  215. end { Order };
  216.  
  217. { --------------------------
  218.   OPENING procedure for demo
  219.   -------------------------- }
  220. Procedure Opening;
  221. begin
  222.      { Initialize }
  223.      TimeElapsed := 0;
  224.  
  225.           { Build opening screen - Page[1] }
  226.      FillHeap ( Page[1],  1, 1, 80, 25, ' ', 30);
  227.      BoxHeap  ( Page[1], 13, 6, 67, 20, 2 ,14);
  228.      HeapAt   ( Page[1], 14, 7, 66, 19, 0 );
  229.      for i := 1 to 6 do
  230.         PutHeap ( Page[1], h, Center(logo[i],53,' '), 14, 9+i, 14);
  231.      RestoreScreen ( page[1] );
  232.      wait(3);
  233.  
  234.           { Horizontal Wipe to clear screen }
  235.      for i := 1 to 40 do
  236.      begin
  237.         RemBlk (1+(i-1)*2,1,2+(i-1)*2,25);
  238.         SetAtt (1+(i-1)*2,1,2+(i-1)*2,25,14);
  239.      end;
  240.  
  241.           { Display ID screen }
  242.      SetAtt ( 23,  4, 56, 10, $1E);
  243.      SetAtt ( 23, 11, 56, 17, $1E);
  244.      PutStr ( H, Center ( 'Introducing', 34, #32), 23,  7, 30 );
  245.      PutStr ( H, Center ( 'BOOSTERS', 34, #32), 23, 9, 30 );
  246.      PutStr ( H, Center ( 'Assembly-Honed Helpers', 34, #32), 23, 12, 30 );
  247.      PutStr ( H, Center ( 'For Turbo Pascal Programmers', 34, #32), 23,13,30 );
  248.      BoxUL   ( 23,  4, 56, 17, 1, 30 );
  249.      wait(4);
  250.  
  251.           { Build supplement box on heap }
  252.      SaveScreen ( page[1] );
  253.           { Move ID screen to make room for supplement box }
  254.      MblkHeap ( page[1], 23,  4, 56, 17, 5,  4 );
  255.           { Draw supplement box }
  256.      BoxHeap  ( page[1], 43,  4, 76, 17, 2, 14 );
  257.      PutHeap  ( page[1], H, Center ( 'String and video routines',32,#32),
  258.               44,  8, 12 );
  259.      PutHeap  ( page[1], H, Center ( '- plus -', 32, #32), 44, 10, 12 );
  260.      PutHeap  ( page[1], H, Center ( 'Special-purpose programs', 32, #32),
  261.               44, 12, 12 );
  262.      RestoreScreen ( page[1] );
  263.      wait(5);
  264.  
  265.      FillHeap ( Page[1],  1,  1, 80, 25, ' ', 14 );
  266.      HeapAt   ( Page[1], 23,  4, 56, 17, 30);
  267.      BoxHeap  ( Page[1], 23,  4, 56, 17, 1, 30);
  268.      PutHeap  ( Page[1], H, Center ('BOOSTERS DEMO WILL', 32, #32),
  269.               24,  6, 30);
  270.      PutHeap  ( Page[1], H, Left   ('- Run by itself',28,#32),
  271.               26,  8, 30);
  272.      PutHeap  ( Page[1], H, Left   ('- Advance faster with', 28, #32),
  273.               26, 10, 30);
  274.      PutHeap  ( Page[1], H, Left   ('  repeated key presses',28,#32),
  275.               26, 11, 30);
  276.      PutHeap  ( Page[1], H, Left   ('- Halt and wait for another', 28, #32),
  277.               26,13,30);
  278.      PutHeap  ( Page[1], H, Left   ('  key press if you press HOME', 29, #32),
  279.               26,14,30);
  280.      PutHeap  ( Page[1], H, Center (#06+#32+#06+#32+#06, 32, #32), 24, 16,30);
  281.      RestoreScreen ( page[1] );
  282.      wait(7);
  283. end { Opening } ;
  284.  
  285. { -----------------------------
  286.   OVERVIEW of Boosters routines
  287.   ----------------------------- }
  288. Procedure OverView;
  289. begin
  290.  
  291.           { Build Boosters overview chart on heap }
  292.           { First, clear out a page . . . . }
  293.      FillHeap ( Page[1],  1, 1, 80, 25, ' ', 0);
  294.           { Then draw the five boxes . . . }
  295.      BoxHeap  ( Page[1], 30,  1, 50,  5, 3, 14 );
  296.      BoxHeap  ( Page[1], 30,  8, 50, 12, 3, 14);
  297.      BoxHeap  ( Page[1],  5, 15, 25, 17, 1, 14);
  298.      BoxHeap  ( Page[1], 30, 15, 50, 17, 1, 14);
  299.      BoxHeap  ( Page[1], 55, 15, 75, 17, 1, 14);
  300.  
  301.           { Draw vertical connectors . . . }
  302.      PutHeap  ( Page[1], H, #194,      40,  5, 14);
  303.      PutHeap  ( Page[1], V, #179+#179, 40,  6, 14);
  304.      PutHeap  ( Page[1], V, #193,      40,  8, 14);
  305.      PutHeap  ( Page[1], H, #194,      40, 12, 14);
  306.      PutHeap  ( Page[1], V, #179+#179, 40, 13, 14);
  307.  
  308.           { Draw horizontal connecting lines . . . }
  309.      PutHeap  ( Page[1], H, Copies (#196, 25), 40, 14, 14);
  310.      PutHeap  ( Page[1], H, Copies (#196, 25), 15, 14, 14);
  311.  
  312.           { Draw more connectors . . . }
  313.      PutHeap  ( Page[1], H, #197, 40, 14, 14);
  314.      PutHeap  ( Page[1], H, #193, 40, 15, 14);
  315.      PutHeap  ( Page[1], V, #218, 15, 14, 14);
  316.      PutHeap  ( Page[1], V, #193, 15, 15, 14);
  317.      PutHeap  ( Page[1], V, #191, 65, 14, 14);
  318.      PutHeap  ( Page[1], V, #193, 65, 15, 14);
  319.  
  320.           { Write text into boxes . . . }
  321.      PutHeap  ( Page[1], H, Center ('MS-DOS and ', 19, ' '), 31,  2, 14);
  322.      PutHeap  ( Page[1], H, Center ('Turbo Pascal',19, ' '), 31,  3, 14);
  323.      PutHeap  ( Page[1], H, Center ('Environment' ,19, ' '), 31,  4, 14);
  324.  
  325.      PutHeap  ( Page[1], H, Center (#$11+' BOOSTERS '#$10, 19, ' '), 31,10,14);
  326.      PutHeap  ( Page[1], H, Center ('String Functions', 19, ' '),  6, 16, 14);
  327.      PutHeap  ( Page[1], H, Center ('Special Routines', 19, ' '), 31, 16, 14);
  328.      PutHeap  ( Page[1], H, Center ('Video Procedures', 19, ' '), 56, 16, 14);
  329.  
  330.           { Finally, display the overview chart, quickly and w/o snow }
  331.      RestoreScreen ( page[1] );
  332.      Wait(4);
  333. end { OverView };
  334.  
  335. { --------------------
  336.   STRING function demo
  337.   -------------------- }
  338. Procedure StringDemo;
  339. begin
  340.  
  341.           { Clear page for string function demo }
  342.      FillHeap ( Page[2],  1,  1, 80, 25, ' ', 14 );
  343.  
  344.           { Draw boxes for text }
  345.      BoxHeap  ( Page[2],  5,  8, 25, 10, 1, 14);
  346.      BoxHeap  ( Page[2],  5, 10, 25, 19, 4, 14);
  347.      PutHeap  ( Page[2], H, Center ('String Functions', 19, ' '),  6,  9, 14);
  348.  
  349.           { Draw connectors to make two boxes seem like one }
  350.      PutHeap ( Page[2], V, #198,  5, 10, 14);
  351.      PutHeap ( Page[2], V, #181, 25, 10, 14);
  352.  
  353.      s := 'Center  Copies  Left    OverStr Right   Strip   Upper   CopyStr ';
  354.      for i := 1 to 8 do
  355.         PutHeap ( Page[2], H, Copy( S, 1+(i-1)*8, 8), 12, 10 + i, 14);
  356.      RestoreScreen ( Page[2] );
  357.      Wait(2);
  358.  
  359.           { Draw large box in which to write poem }
  360.      BoxUl  ( 30,  8, 76, 19,  3, 14);
  361.  
  362.      Att1 := $1E;
  363.      Boxul  ( 20, 22, 59, 24,  2, Att1 );
  364.  
  365.      PutStr ( H, Center ('Center and pad a string in a field',38,' '),
  366.                  21,23,Att1);
  367.  
  368.      SetAtt (  6, 11, 24, 11, 112);
  369.      PutStr ( H, Center ('Growing Pains', 44, ' '), 31, 11, 14);
  370.      Wait(3);
  371.  
  372.      SetAtt (  6, 11, 24, 11, 14);
  373.      SetAtt (  6, 13, 24, 13, 112);
  374.      PutStr ( H, Center ('Left-justify and pad a string',38,' '),
  375.                  21,23,Att1);
  376.      PutStr ( H, Left ('There are no miracles--', 44, ' '), 32, 13, 14);
  377.      Wait(3);
  378.  
  379.      SetAtt (  6, 13, 24, 13, 14);
  380.      SetAtt (  6, 15, 24, 15, 112);
  381.      PutStr ( H, Center ('Right-justify and pad a string',38,' '),
  382.                  21,23,Att1);
  383.      PutStr ( H, Right ('--just discipline--', 44, ' '), 31, 15, 14);
  384.      Wait(3);
  385.  
  386.      SetAtt (  6, 15, 24, 15, 14);
  387.      SetAtt (  6, 16, 24, 16, 112);
  388.      PutStr ( H, Center ('Strip leading and trailing characters',38,' '),
  389.                  21,23,Att1);
  390.      PutStr ( H, Right ( Strip ('--just discipline--','-'), 44, ' '),31,16,14);
  391.      Wait(3);
  392.  
  393.      SetAtt (  6, 16, 24, 16, 14);
  394.      SetAtt (  6, 14, 24, 14, 112);
  395.      PutStr ( H, Center ('Overlay and pad one string on another',38,' '),
  396.                  21,23,Att1);
  397.      PutStr ( H, OverStr ( 'just discipline','There are no miracles--',
  398.                          24,15,' '), 32, 14, 14);
  399.      Wait(3);
  400.  
  401.      SetAtt (  6, 14, 24, 14, 14);
  402.      SetAtt (  6, 12, 24, 12, 112);
  403.      PutStr ( H, Center ('Create a string of like characters',38,' '),
  404.                  21,23,Att1);
  405.      PutStr ( H, Center ( Copies ( '-',13), 44, ' '), 31, 12, 14);
  406.      Wait(3);
  407.  
  408.      SetAtt (  6, 12, 24, 12, 14);
  409.      SetAtt (  6, 17, 24, 17, 112);
  410.      PutStr ( H, Center ('- Uppercase Function -',38,' '),
  411.                  21,23,Att1);
  412.      PutStr ( H, Center ( Upper ( 'amen'), 44, ' '), 31, 17, 14);
  413.      Wait(3);
  414.  
  415.      SetAtt (  6, 17, 24, 17, 14);
  416.      SetAtt (  6, 18, 24, 18, 112);
  417.      PutStr ( H, Center ('Create a string of strings',38,' '),
  418.                  21,23,Att1);
  419.      PutStr ( H, Center ( CopyStr ('Amen ',9), 45, ' '), 31, 18, 14);
  420.      wait(3);
  421.  
  422.           { Flash status box on bottom }
  423.      for i := 1 to 6 do
  424.      begin
  425.         SetAtt ( 21, 23, 58, 23,   0 );
  426.         delay ( 30 );
  427.         SetAtt ( 21, 23, 58, 23, 112 );
  428.         delay ( 30 );
  429.      end;
  430.      PutStr ( H, Center ('Create a string of strings',38,' '),
  431.                  21,23,Att1);
  432.      wait(1);
  433.  
  434.           { Draw micro checkerboard }
  435.      for i := 1 to 20 do
  436.         PutStr ( h, CopyStr ('▄▀',40), 1,i,7);
  437.      wait(2);
  438.      RestoreScreen ( page[1] );
  439.      Wait(4);
  440. end { StringDemo };
  441.  
  442. { -------------------
  443.   VIDEO routines demo
  444.   ------------------- }
  445. Procedure VideoDemo;
  446. begin
  447.  
  448.      FillHeap ( Page[2],  1,  1, 80, 25, ' ', 14 );
  449.      BoxHeap  ( Page[2], 55,  8, 75, 10,  1, 14 );
  450.      BoxHeap  ( Page[2], 55, 10, 75, 19,  4, 14 );
  451.           { Draw connectors to make two boxes look like one }
  452.      PutHeap  ( Page[2], V, #198, 55, 10, 14);
  453.      PutHeap  ( Page[2], V, #181, 75, 10, 14);
  454.      PutHeap  ( Page[2], H, Center ('Video Procedures', 19, ' '), 56,  9, 14);
  455.  
  456.      s := 'CopyBlk GetStr  FindStr MoveBg  MoveBlk PutStr  RemBlk  SetAtt  ';
  457.      for i := 1 to 8 do
  458.         PutHeap ( Page[2], H, Copy( S, 1+(i-1)*8, 8), 62, 10 + i, 14);
  459.      RestoreScreen ( Page[2] );
  460.      wait(2);
  461.  
  462.           { Write status block centered on bottom of screen }
  463.      Att1 := $1E;
  464.      Boxul ( 20, 22, 59, 24, 2, Att1 );
  465.  
  466.      SetAtt ( 56, 16, 74, 16, 112);
  467.      PutStr ( H, Center ('Put String to display VERTICALLY',38,' '),
  468.                  21,23,Att1);
  469.      PutStr ( V, Copies (#$B3,12), 20,  6, 14);
  470.      Wait(3);
  471.  
  472.      PutStr ( H, Center ('Put String to display HORIZONTALLY',38,' '),
  473.                  21,23,Att1);
  474.      PutStr ( H, Copies (#$C4,30), 20, 6, 14);
  475.      PutStr ( H, #$DA, 20, 6, 14);
  476.      Wait(3);
  477.  
  478.      SetAtt ( 56, 16, 74, 16, 14);
  479.      SetAtt ( 56, 15, 74, 15, 112);
  480.  
  481.      SaveScreen ( page[3] );
  482.      MblkHeap ( page[3], 20, 6, 49, 17, 10, 6);
  483.      MblkHeap ( page[3], 10, 6, 39, 6, 10, 17);
  484.      PutHeap  ( page[3], h, #$C0, 10, 17, 14);
  485.      RestoreScreen ( page[3] );
  486.      PutStr ( H, Center ('Move a Block on the display',38,' '),
  487.                  21,23,Att1);
  488.      wait(3);
  489.  
  490.      PutStr ( H, Center ('- PutStr again -',38,' '),
  491.                  21,23,Att1);
  492.      SetAtt ( 56, 15, 74, 15, 14);
  493.      SetAtt ( 56, 16, 74, 16, 112);
  494.      PutStr ( H, Copies ( #$DB,4 ), 38, 16, 14);
  495.      PutStr ( H, Copies ( #$DF,4 ), 38, 17, 14);
  496.      wait(3);
  497.  
  498.      PutStr ( H, Center ('- Copy Blocks -',38,' '),
  499.                  21,23,Att1);
  500.      SetAtt ( 56, 16, 74, 16, 14);
  501.      SetAtt ( 56, 11, 74, 11, 112);
  502.      CopyBlk ( 38, 16, 41, 16, 38, 15);
  503.      wait(3);
  504.  
  505.      PutStr ( H, Center ('- Move them -',38,' '),
  506.                  21,23,Att1);
  507.      SetAtt ( 56, 11, 74, 11, 14);
  508.      SetAtt ( 56, 15, 74, 15, 112);
  509.      MoveBlk (38, 15, 41, 17, 13, 15);
  510.      PutStr  ( H, Copies ( #$C4,4 ), 38, 17, 14);
  511.      wait(3);
  512.  
  513.      PutStr ( H, Center ('- Copy more blocks -',38,' '),
  514.                  21,23,Att1);
  515.      SetAtt ( 56, 15, 74, 15, 14);
  516.      SetAtt ( 56, 11, 74, 11, 112);
  517.      for i := 1 to 3 do
  518.         CopyBlk ( 13, 15, 16, 16, 20, 15-(i-1)*2);
  519.      PutStr ( H, Copies ( #$DF,4 ), 20, 17, 14);
  520.  
  521.      for i := 1 to 8 do
  522.         CopyBlk ( 13, 15, 16, 16, 27, 15-(i-1)*2);
  523.      PutStr ( H, Copies ( #$DF,4 ), 27, 17, 14);
  524.  
  525.      PutStr ( H, #$C1, 34, 17, 14);
  526.      wait(3);
  527.  
  528.      PutStr ( H, Center ('- PutStr some labels -',38,' '),
  529.                  21,23,Att1);
  530.      SetAtt ( 56, 11, 74, 11, 14);
  531.      SetAtt ( 56, 16, 74, 16, 112);
  532.      PutStr ( V, Center ( 'POTENCY',12,' '), 3,6,14);
  533.      PutStr ( V, Center ( 'OF',12,' '), 5,6,14);
  534.      PutStr ( V, Center ( 'WEAPONS',12,' '), 7,6,14);
  535.      PutStr ( H, 'I     II    III   IV',15,18,14);
  536.      PutStr ( H, Center ('WORLD WARS',28,' '),12,19,14);
  537.      wait(3);
  538.  
  539.      PutStr ( H, Center ('Change display attributes',38,' '),
  540.                  21,23,Att1);
  541.      SetAtt ( 56, 16, 74, 16, 14);
  542.      SetAtt ( 56, 18, 74, 18, 112);
  543.      SetAtt ( 13, 15, 16, 16, 12);
  544.      SetAtt ( 20, 11, 23, 16, 10);
  545.      SetAtt ( 27,  1, 30, 16,  9);
  546.      PutStr ( H, Copies ( #$DF,4 ), 13, 17, 12);
  547.      PutStr ( H, Copies ( #$DF,4 ), 20, 17, 10);
  548.      PutStr ( H, Copies ( #$DF,4 ), 27, 17,  9);
  549.      wait(4);
  550.  
  551.      PutStr ( H, Center ('- Remove Blocks -',38,' '),
  552.                  21,23,Att1);
  553.      SetAtt ( 56, 18, 74, 18, 14);
  554.      SetAtt ( 56, 17, 74, 17, 112);
  555.      RemBlk ( 27, 1, 34, 18);
  556.      wait(5);
  557.  
  558.      SaveScreen ( page[3] );
  559.      HeapAt ( page[3], 56, 17, 74, 17, 14);
  560.      HeapAt ( page[3], 56, 15, 74, 15, 112);
  561.      FillHeap ( page[3], 35, 17, 41, 17, ' ', 14 );
  562.      FstrHeap ( page[3], 'WOR', Xheap, Yheap );
  563.      MblkHeap ( page[3], Xheap, Yheap, Xheap+9, Yheap, Xheap-7, Yheap);
  564.      RestoreScreen ( page[3] );
  565.      PutStr ( H, Center ('- Straighten up a bit -',38,' '),
  566.                  21,23,Att1);
  567.      wait(4);
  568.  
  569.      PutStr ( H, Center ('Hunt for string & park cursor',38,' '),
  570.                  21,23,Att1);
  571.      SetAtt ( 56, 15, 74, 15, 14);
  572.      SetAtt ( 56, 13, 74, 13, 112);
  573.      FindStr ( 1, 19, 'WO', 0, ecode );
  574.      CursorOn;
  575.      wait(5);
  576.  
  577.      SaveX := WhereX;
  578.      SaveY := WhereY;
  579.      PutStr ( H, Center ('Read display across or down',38,' '),
  580.                  21,23,Att1);
  581.      SetAtt ( 56, 13, 74, 13, 14);
  582.      SetAtt ( 56, 12, 74, 12, 112);
  583.      GetStr ( H, S, SaveX, SaveY, 10);
  584.      SetAtt ( SaveX, SaveY, SaveX+9, SaveY, 112);
  585.      wait(5);
  586.      CursorOff;
  587.  
  588.      SaveScreen ( page[3] );
  589.      HeapAt ( page[3], 56, 12, 74, 12, 14);
  590.      HeapAt ( page[3], 56, 15, 74, 15, 112);
  591.  
  592.           { Move block left to right to affect an erase }
  593.      MblkHeap ( page[3], 55,  7, 80, 20,  1,  7 );
  594.      PutHeap  ( page[3], H, Center ('An alternative to RemBlk',38,' '),
  595.                  21,23,Att1);
  596.      RestoreScreen ( page[3] );
  597.      wait(1);
  598.  
  599.           { Reposition block on right side of screen }
  600.      MblkHeap (  page[3],  1,  7, 22, 20, 55,  7 );
  601.      RestoreScreen ( page[3] );
  602.      wait(4);
  603.  
  604.      PutHeap ( page[3], H, Center ('Take control of the screen',38,' '),
  605.                  21,23,Att1);
  606.      HeapAt  ( page[3], 56, 15, 74, 15, 14);
  607.      HeapAt  ( page[3], 56, 11, 74, 11, 112);
  608.      CblkHeap ( page[3], 55,  8, 75, 20, 30,  8 );
  609.      CblkHeap ( page[3], 55,  8, 75, 20,  5,  8 );
  610.      RestoreScreen ( page[3] );
  611.      wait(4);
  612.  
  613.      SetAtt ( 56, 11, 74, 11, 14);
  614.      SetAtt ( 30, 11, 50, 11, 14);
  615.      SetAtt (  6, 11, 24, 11, 14);
  616.      SetAtt ( 56, 14, 74, 14, 112);
  617.      SetAtt ( 31, 14, 49, 14, 112);
  618.      SetAtt (  6, 14, 24, 14, 112);
  619.  
  620.      SaveScreen ( page[3] );
  621.  
  622.           { Move status block from bottom to top of screen }
  623.      for i := 22 Downto 3 do
  624.      begin
  625.         MoveBg ( page[3], 20, i, 60, i+2, 20, i-1 );
  626.         delay(30);
  627.      end;
  628.      wait(1);
  629.  
  630.      PutStr ( H, Center ('Move a block over a background',38,' '),
  631.                  21,23,Att1);
  632.  
  633.           { Flash status box on bottom }
  634.      for i := 1 to 6 do
  635.      begin
  636.         SetAtt ( 21, 23, 58, 23,   0 );
  637.         delay ( 30 );
  638.         SetAtt ( 21, 23, 58, 23, 112 );
  639.         delay ( 30 );
  640.      end;
  641.  
  642.      PutStr ( H, Center ('Move a block over a background',38,' '),
  643.                  21,23,Att1);
  644.      wait(2);
  645.  
  646.      SaveScreen ( page[3] );
  647.  
  648.           { Move status block from bottom to top of screen }
  649.      for i := 22 Downto 3 do
  650.      begin
  651.         MoveBg ( page[3], 20, i, 60, i+2, 20, i-1 );
  652.         delay(30);
  653.      end;
  654.      PutStr ( H, Center ('Once was not enough',38,' '),
  655.                  21,23,Att1);
  656.      Wait(3);
  657.  
  658.      RestoreScreen ( page[2] );
  659.      PutStr ( V, #196, 65,  8, 14);
  660.      wait(1);
  661.  
  662.           { Restore overview chart }
  663.      RestoreScreen ( page[1] );
  664.      Wait(4);
  665. end { VideoDemo };
  666.  
  667. { ---------------------
  668.   SPECIAL routines demo
  669.   --------------------- }
  670. Procedure SpecialDemo;
  671. var
  672.    TrackTime : Integer;
  673. begin
  674.  
  675.      FillHeap ( page[3], 1, 1, 80, 25, ' ', 14 );
  676.      BoxHeap  ( page[3], 30, 2, 51, 4, 1, 14 );
  677.      PutHeap  ( Page[3], H, Center ('Special Routines', 19, ' '), 31, 3, 14);
  678.      RestoreScreen ( page[3] );
  679.  
  680.           { Create and display Chorus Line }
  681.      S := 'BoxUL     TimeXY    Cursors   Dows      Timer     Exec      '+
  682.           'NsOrbit   Heap I/O  ';
  683.      PutStr ( H, S, 1, 6, 112);
  684.  
  685.           { Flash chorus line ( make 'S' blink) }
  686.      for i := 1 to 3 do
  687.         for j := 1 to 8 do
  688.         begin
  689.            SetAtt ( 1+(j-1)*10, 6, 10+(j-1)*10, 6 , 14);
  690.            delay(40);
  691.            SetAtt ( 1+(j-1)*10, 6, 10+(j-1)*10, 6 , 112);
  692.            delay(40);
  693.         end;
  694.      wait(3);
  695.  
  696.           { Draw status box centered near bottom of screen }
  697.      Boxul ( 20, 22, 59, 24, 2, Att1 );
  698.      PutStr ( H, Center ('Boxes : 4 styles in any attribute',38,' '),
  699.                  21,23,Att1);
  700.      MoveBlk ( 1, 6, 10, 6, 36, 9);
  701.      wait(3);
  702.  
  703.           { Build four boxes in page[4] of heap }
  704.      SaveScreen ( page[3] );
  705.      SaveScreen ( page[4] );
  706.      BoxHeap    ( page[4],  1, 11, 20, 19, 1,   7);
  707.      BoxHeap    ( page[4], 21, 11, 40, 19, 2,  14);
  708.      BoxHeap    ( page[4], 41, 11, 60, 19, 3, 112);
  709.      BoxHeap    ( page[4], 61, 11, 80, 19, 4,  14);
  710.  
  711.      PutHeap ( page[4], h, Center ('Main Menu',18,' '), 2, 14,  7 );
  712.      PutHeap ( page[4], h, Center ('Next Menu',18,' '),22, 14, 14 );
  713.      PutHeap ( page[4], h, Center ('Wine Menu',18,' '),42, 14, 14 );
  714.      PutHeap ( page[4], h, Center ('Last Menu',18,' '),62, 14,  7 );
  715.           { Display boxes }
  716.      RestoreScreen ( page[4] );
  717.      wait(6);
  718.  
  719.           { Clear four boxes from screen }
  720.      RestoreScreen ( page[3] );
  721.  
  722.            { Put BoxUL back in chorus line and get NsOrbit }
  723.      MoveBlk ( 36, 9, 45, 9,  1, 6);
  724.      MoveBlk ( 61, 6, 70, 6, 36, 9);
  725.  
  726.  
  727.           { Draw NsOrbit box }
  728.      BoxUL (31, 11, 50, 19, 1, 14);
  729.      PutStr ( H, Center ('Orbit some text',38,' '),
  730.                  21,23,Att1);
  731.      wait(2);
  732.      PutStr  ( h, Center ( 'Watch out for',18,' '),  32, 13, 14 );
  733.      PutStr  ( h, Center ( 'Heavenly',18,' '), 32, 15, 14 );
  734.      PutStr  ( h, Center ( 'Hammers',18,' '), 32, 17, 14 );
  735.      NsOrbit ( 31, 11, 50, 19, 2, 3);
  736.      wait(2);
  737.  
  738.           { Remove Heavenly Hammer box }
  739.      RemBlk ( 31, 11, 50, 19 );
  740.  
  741.           { Put NsOrbit back in chorus line and get Heap I/O }
  742.      MoveBlk ( 36, 9, 45, 9, 61, 6);
  743.      MoveBlk ( 71, 6, 80, 6, 36, 9);
  744.  
  745.      PutStr ( H, Center ('Speed SANS snow on CGA',38,' '),
  746.                  21,23,Att1);
  747.      wait(2);
  748.      PutStr ( h, Center('Display NINE screens',80,' '), 1, 13, 14);
  749.      PutStr ( h, Center('Be back in a flash',80,' '), 1, 14, 14);
  750.      SaveScreen ( page[3] );
  751.      wait(3);
  752.      j := 30;
  753.      RestoreScreen ( page[1] );
  754.      delay(j);
  755.      RestoreScreen ( page[2] );
  756.      delay(j);
  757.      RestoreScreen ( page[4] );
  758.      delay(j);
  759.      RestoreScreen ( page[1] );
  760.      delay(j);
  761.      RestoreScreen ( page[2] );
  762.      delay(j);
  763.      RestoreScreen ( page[4] );
  764.      delay(j);
  765.      RestoreScreen ( page[1] );
  766.      delay(j);
  767.      RestoreScreen ( page[2] );
  768.      delay(j);
  769.      RestoreScreen ( page[4] );
  770.      delay(j);
  771.      RestoreScreen ( page[3] );
  772.      wait(1);
  773.      PutStr ( h, Center('And that included a 30 millisecond delay',80,' '),
  774.                          1, 13, 14);
  775.      PutStr ( h, Center('between displays, so they could be seen.',80,' '),
  776.                          1, 14, 14);
  777.      wait(5);
  778.      MoveBlk (36, 9, 45, 9, 71, 6);
  779.      RemBlk ( 1, 13, 80, 14 );
  780.  
  781.           { Flash status box on bottom }
  782.      PutStr ( H, Center ('Combine tools for easy menu making',38,' '),
  783.                  21,23,Att1);
  784.      for i := 1 to 6 do
  785.      begin
  786.         SetAtt ( 21, 23, 58, 23,   0 );
  787.         delay ( 30 );
  788.         SetAtt ( 21, 23, 58, 23, 112 );
  789.         delay ( 30 );
  790.      end;
  791.      PutStr ( H, Center ('Combine tools for easy menu making',38,' '),
  792.                  21,23,Att1);
  793.      wait(2);
  794.      SaveScreen ( page[3] );
  795.  
  796.           { Display mock menu }
  797.      Menu;
  798.  
  799.      RestoreScreen ( page[3] );
  800.      wait(1);
  801.  
  802.      MoveBlk (41, 6, 50, 6, 36, 9);
  803.      PutStr ( H, Center ('A Boolean Process-Timer',38,' '),
  804.                  21,23,Att1);
  805.      wait(2);
  806.      PutStr ( H, #17+#196+#196+' Set the timer to 5',52, 9, 14);
  807.      PutStr ( H, '(5)', 41,9,112);
  808.      wait(2);
  809.  
  810.      Boxul ( 31, 11, 50, 19, 3, 14);
  811.  
  812.      TrackTime := TimeElapsed;
  813.      i := 5;
  814.      PutStr ( H, Center ('Process while the timer ticks',38,' '),
  815.                  21,23,Att1);
  816.      window ( 32, 12, 49, 18);
  817.      gotoXY(1,1);
  818.      repeat
  819.         if TrackTime <> TimeElapsed then
  820.         begin
  821.            i := pred(i);
  822.            TrackTime := TimeElapsed;
  823.            SaveX := WhereX;
  824.            SaveY := WhereY;
  825.            PutStr ( h, chr($30+i), 42, 9, 112);
  826.            gotoXY(SaveX,SaveY);
  827.         end;
  828.         write('Processing . . .  ');
  829.      until Timer(5);
  830.      Sound(110);
  831.      Delay(200);
  832.      NoSound;
  833.      window(1,1,80,25);
  834.      RemBlk (31,11,50,19);
  835.      Wait(1);
  836.  
  837.      PutStr ( H, '   ', 41,9,112);
  838.      PutStr ( H, Copies(' ',22), 52,9,14);
  839.  
  840.      MoveBlk (36, 9, 45, 9, 41, 6);
  841.  
  842.      PutStr ( H, Center ('Turn ON the cursor . . .',38,' '),
  843.                  21,23,Att1);
  844.      MoveBlk (21, 6, 30, 6, 36, 9);
  845.      FindStr ( 1,9, 'Cur',9,ecode );
  846.      CursorOn;
  847.      wait(2);
  848.      PutStr ( H, Center ('. . . and turn it OFF',38,' '),
  849.                  21,23,Att1);
  850.      CursorOff;
  851.      wait(1);
  852.      MoveBlk (36, 9, 45, 9, 21, 6);
  853.  
  854.      MoveBlk (11, 6, 20, 6, 36, 9);
  855.      PutStr ( H, Center ('Set and display time of day',38,' '),
  856.                  21,23,Att1);
  857.      Repeat
  858.         TimeXY ( 37, 13 );
  859.      until Timer(6) or KeyPressed;
  860.      if KeyPressed then
  861.         read(Kbd,ch);
  862.      RemBlk ( 37, 13, 47, 13 );
  863.      MoveBlk (36, 9, 45, 9, 11, 6);
  864.      wait(1);
  865.  
  866.      MoveBlk (31, 6, 40, 6, 36, 9);
  867.      PutStr ( H, Center ('Day-of-the-week function',38,' '),
  868.                  21,23,Att1);
  869.      wait(1);
  870.  
  871.           { Display Calendars using Dows }
  872.      SaveScreen ( page[3] );
  873.      SaveScreen ( page[4] );
  874.      Randomize;
  875.      CalHeap (Page[4], 1+Random(12), 1960+Random(31), 29, 8);
  876.      CalHeap (Page[4], 1+Random(12), 1960+Random(31), 55, 8);
  877.      Move ( page[4]^, page[2]^, 4000 );
  878.      CalHeap (Page[4], 1+Random(12), 1960+Random(31),  3, 8);
  879.      PutHeap ( page[2], h, Center ('Using Movebg ',38,' '), 21,23, Att1 );
  880.      RestoreScreen ( page[4] );
  881.      PutStr ( H, Center ('Routine CalHeap, which uses DOWS',38,' '),
  882.                  21,23,Att1);
  883.      wait(20);
  884.  
  885.           { Move left-most calendar to center }
  886.      for i := 3 to 28 do
  887.      begin
  888.         Movebg ( page[2],  i,  8, i+22, 22, i+1,  8 );
  889.         delay(130);
  890.      end;
  891.  
  892.      wait(2);
  893.      RestoreScreen ( page[3] );
  894.  
  895.      wait(2);
  896.      MoveBlk (36, 9, 45, 9, 31, 6);
  897.      wait(2);
  898.      MoveBlk (51, 6, 60, 6, 36, 9);
  899.      PutStr ( H, Center ('Execute another program and return',38,' '),
  900.                  21,23,Att1);
  901.      wait(2);
  902.      PutStr ( H, Center ('Available on BoDemo.COM',38,' '),21,13,14);
  903. {
  904.      SaveScreen (page[2]);
  905.  
  906.      ClrScr;
  907.      FileDesc := 'A:\COMMAND.COM';
  908.      ComLine  := 'command /c DIR /W';
  909.      Exec (FileDesc,ComLine,Ecode);
  910.      SaveScreen ( page[3] );
  911.      Wait(2);
  912.  
  913.      FstrHeap ( page[3], 'bytes free', Xheap, Yheap );
  914.      GetStr  (H, S, Xheap-24,Yheap, 40);
  915.  
  916.      RestoreScreen (page[2]);
  917.      wait(2);
  918.      Boxul ( 20, 12, 59, 14, 2, 12 );
  919.      PutStr (H, Center ( Strip (S, ' '), 38,' '), 21, 13, 14);
  920.      PutStr ( H, Center ('Capture output from other programs',38,' '),
  921.                  21,23,Att1);
  922. }
  923.      wait(3);
  924.      RemBlk (20, 12, 59, 14);
  925.      MoveBlk (36, 9, 45, 9, 51, 6);
  926.      wait(2);
  927.  
  928.      RestoreScreen ( page[1] );
  929. end;
  930.  
  931. Procedure Closing;
  932. begin
  933.      CopyBlk ( 30, 15, 51, 17, 30, 19 );
  934.      PutStr ( V, #194+#179, 40, 17, 14);
  935.      PutStr ( H, Center ( 'Word Functions',19,' '), 31, 20, 14);
  936.      wait(2);
  937.      SetAtt ( 31, 20, 49, 20, 12);
  938.      wait(2);
  939.      Order;
  940.      wait(60);
  941. end;
  942.  
  943. BEGIN
  944.    CursorOff;
  945.                      { Allocate heap space for Npage screens }
  946.    Mark ( HeapTop );
  947.    for i := 1 to Npage do
  948.       New ( page[i] );
  949.  
  950.    Repeat
  951.       Opening;
  952.       OverView;
  953.       StringDemo;
  954.       VideoDemo;
  955.       SpecialDemo;
  956.       Closing;
  957.    Until KeyPressed;
  958.  
  959.    CursorOn;
  960.    Release ( HeapTop );
  961. END.
  962.